home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 7 / FM Towns Free Software Collection 7.iso / fb386 / shadow / shadow.bas next >
BASIC Source File  |  1993-11-30  |  3KB  |  76 lines
  1. 1000   '  save "shadow.bas",a
  2. 1010   '------------------------------------------
  3. 1020   '        影文字作成 1
  4. 1030   '        1993/08/04    by  TMA
  5. 1040   '        with Marty Basic Runtime CD
  6. 1050   '------------------------------------------
  7. 1060   x = 20                     ' 開始位置
  8. 1070   y = 80
  9. 1080   fwid = 10                   ' 文字間隔
  10. 1090   '
  11. 1100 *rep
  12. 1110   cls
  13. 1120   input "文字列,倍率,高さ,形式(0:標準 2:斜体) : ",s$,sz,lcnt,ftype
  14. 1130   cw   = sz * 3              ' 文字間隔 
  15. 1140   '-----------------------------------------
  16. 1150   cls
  17. 1160   gosub *dr1
  18. 1170   gosub *dr2
  19. 1180   gosub *mktiff
  20. 1190   gosub *clreol
  21. 1200   print "Hit any Key (Continue = c) :";: a$=input$(1)
  22. 1210   if a$="c" or a$ ="C" then *rep else end
  23. 1220   '------------------------------------------
  24. 1230 *dr1                            ' 下地描画
  25. 1240   for i = 0 to lcnt step 0.5
  26. 1250     symbol (x+i  ,y+i+1),s$,sz,sz,7,0,PSET,ftype,cw
  27. 1260     symbol (x+i+1,y+i  ),s$,sz,sz,7,0,PSET,ftype,cw
  28. 1270   next
  29. 1280   return
  30. 1290 *dr2                            ' 描画
  31. 1300   for i = 0 to 4
  32. 1310     symbol (x+i,y+i),s$,sz,sz,7,0,XOR,ftype,cw
  33. 1320     gosub *clreol
  34. 1330     print "Make file:f / Next:CR :";:a$=input$(1): print a$
  35. 1340     if a$ ="f" or a$="F" then gosub *mktiff       ' file save
  36. 1350   next
  37. 1360   return
  38. 1370   '
  39. 1380 *mktiff                        ' Tiff save
  40. 1390   gosub *clreol
  41. 1400   print "SAVE範囲を左上､右下の順にｸﾘｯｸしてください。(中止:右ｸﾘｯｸ2回)"
  42. 1410   sp = 0: can = 0
  43. 1420   mouse 0: mouse 1,,,1
  44. 1430   while sp <> 4
  45. 1440     if mouse(2,0) or mouse(2,1) then gosub *getmp  
  46. 1450   wend
  47. 1460   if can = 1 then color 2:print "Canceled": wait 100: color 7:return
  48. 1470   line(p(0),p(1))-(p(2),p(3)),pset,5,B
  49. 1480   f$=""
  50. 1490   gosub *clreol
  51. 1500   input "save filename ( with '.TIF' ,Cansel=CR) :",f$
  52. 1510   line(p(0),p(1))-(p(2),p(3)),preset,5,B
  53. 1520   if f$="" then return
  54. 1530   on error goto *ertr  ' 同一名称はエラー 
  55. 1540   save@ f$, (p(0),p(1))-(p(2),p(3))
  56. 1550   on error goto 0
  57. 1560   mouse 1,,,0          ' ﾏｳｽ 消去
  58. 1570   return
  59. 1580   '
  60. 1590  *getmp                ' ﾏｳｽ ｲﾁ ｼｭﾄｸ 
  61. 1600   if mouse(2,1) = -1 THEN CAN = 1 ELSE CAN = 0  ' cansel ?
  62. 1610   p(sp) = mouse(4,0): p(sp+1) = mouse(5,0)
  63. 1620   sp = sp + 2
  64. 1630   if sp=2 then pset(p(0),p(1)),5 :beep:wait 100 
  65. 1640   return
  66. 1650 '
  67. 1660 *clreol                    ' ｷﾞｮｳ ﾉ ｵﾜﾘﾏﾃﾞ clr
  68. 1670   locate 0,0: print space$(78);
  69. 1680   locate 0,0
  70. 1690   locate 1,0: print space$(78);
  71. 1700   locate 1,0
  72. 1710   return
  73. 1720 *ertr
  74. 1730   if err =64 then kill f$ else ? "err,erl :" err,erl stop
  75. 1740   resume
  76.